home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / SCIENTIF / 1256A.ZIP / RADDECAY.TRU < prev    next >
Text File  |  1987-11-19  |  10KB  |  251 lines
  1. !                                  Raddecay 2.0
  2. !                               *****************
  3. !                    Copyright (c) 1987 Grove Engineering, Inc.
  4. !                               All rights reserved
  5. !                15215 Shady Grove Rd., Suite 202, Rockville, MD 20850
  6. !                                  (301) 258-2727
  7. !
  8. !                                *****************
  9. !                            POST RELEASE REVISION HISTORY
  10. !                          
  11. ! 2.00: Negin/Tocus - Initial release
  12. !
  13. ! Program changes:
  14. !       2.01 - 10/24/87
  15. !       Bound in text files READINFO.DOC AND FILEINFO.DOC
  16. !       Faster box routine
  17. !       Halflife print format modified to accomodate double digit exponentials
  18. !
  19. !       2.02 - 11/20/87
  20. !       Added full names and atomic weight info
  21. !       Textshow calls modified to ensure proper box alignment with coprocessor - True Basic fix
  22. !
  23. LIBRARY "\MS\RADDECAY\RADDKLIB.TRC"
  24. LIBRARY "\MS\TRC\DKLIB.TRC"
  25. LIBRARY "\MS\TRC\PCSTUFF.TRC"
  26. LIBRARY "\TRU\3dLIB.TRC",  "\TRU\ARC.TRC",   "\TRU\PATLIB.TRC"
  27. LIBRARY "\TRU\TEXTLIB.TRC","\TRU\STRLIB.TRC","\TRU\SCRLIB.TRC"
  28. LIBRARY "\TRU\DOSLIB.TRC", "\TRU\FNTLIB.TRC"
  29. LIBRARY "\TRU\POPUPLIB.TRC"
  30.  
  31. ! DEFINITION OF VARIABLES CARRIED THRU COMMON
  32. PUBLIC true                       ! 1
  33. PUBLIC false                      ! 0
  34. PUBLIC graphics_prog              ! true if this prog does graphics (it doesnt)
  35. PUBLIC va$                        ! vertical arrows; this avoids printer gas when listing
  36. PUBLIC ha$                        ! horizontal arrows; be nice to the printer
  37. PUBLIC colour$(4)                 ! string of the color number - NOT THE NAME
  38. PUBLIC recpath$                   ! path for record files, nuclide library and coefficients??
  39. PUBLIC ver$                       ! string of version 
  40. PUBLIC video$                     ! video card type
  41. PUBLIC Program_name$              ! "RADDECAY" for passing to sub FATAL
  42. PUBLIC screensave$                ! holding string for saved screen - text mode
  43. PUBLIC screen$                    ! holding string for saved screen - text mode
  44. PUBLIC first_time                 ! flag for creating new name screen
  45. PUBLIC picrecl                    ! unused, defined in pcstuff
  46. PUBLIC demovideo$                 ! unused, defined in pcstuff
  47. PUBLIC debug                      ! unused, defined in pcstuff
  48. PUBLIC debug2                     ! unused, defined in pcstuff
  49.  
  50. PUBLIC nuclide$(497)              ! names of nuclides
  51. PUBLIC at_names$(100)             ! names of elements
  52. PUBLIC mol_wt(100)                ! atomic weights
  53.  
  54. DECLARE DEF rjust$,elapsed$,spaces$,center$      ! TrueBasic library stuff
  55.  
  56. !***************************** INITIALIZATION *******************************
  57.  
  58. LET true = 1
  59. LET false = 0
  60. LET graphics_prog=false           ! for general config routines
  61. LET Program_name$ = "RADDECAY"    ! for use in error messages
  62. LET ha$ = chr$(27)&", "&chr$(26)  ! horizontal arrows
  63. LET va$ = chr$(24)&", "&chr$(25)  ! vertical arrows
  64. LET first_time = true
  65.  
  66. !*************************** CUSTOMIZED STUFF *****************************
  67. LET ver$ = "2.02"                 ! version - ONLY HARD CODE HERE!
  68. SET CURSOR "off"
  69. LET video$ = "MONO"
  70. LET ver$ = trim$(ver$)
  71. LET sessiondate = date
  72. LET sessiontime = time
  73. DIM dummy(1),menu$(5),pathpurpose$(1)
  74. CLEAR
  75. WHEN ERROR IN                     ! For handling initiation errors
  76.      CALL Get_setup(defaults)     ! Load setup parameters
  77. USE
  78.      CALL fatal(0,"","return")    ! initiation error
  79.      STOP
  80. END WHEN
  81. ! if RADDECAY.DAT doesn't exist then select configuration menu item
  82. IF defaults = true then LET preferred = 4 else LET preferred = 1
  83.  
  84. CALL normal
  85. LET footer$ = " Use "&va$&" and [Enter] or press number to select. "
  86. LET header1$ = " RADDECAY MAIN MENU "
  87. LET menu$(1) = " Execute RADDECAY"
  88. LET menu$(2) = " General information"
  89. LET menu$(3) = " Information about files"
  90. LET menu$(4) = " Computer configuration (also [Esc])"
  91. LET menu$(5) = " Quit this session "
  92. CALL initialize_raddecay
  93. DO
  94.    CLEAR
  95.    CALL generic_menu(menu$,preferred,6,choice,dummy,false,0,header1$,footer$)
  96.    WHEN error in
  97.         SELECT CASE choice
  98.         CASE 1                    ! read file data
  99.              DO
  100.                 WHEN error in
  101.                      CALL Pick_one_nuclide(nuclide)
  102.                      CALL show_nuclide(nuclide)
  103.                 USE
  104.                      IF extype = 100 then   ! expected, handle at this level
  105.                         EXIT DO
  106.                      ELSEIF extype=105  then     ! expected, handle at higher level
  107.                         EXIT HANDLER
  108.                      ELSE
  109.                         CALL fatal(0,"","")      ! unexpected
  110.                      END IF
  111.                 END WHEN
  112.              LOOP
  113.              LET preferred = 1
  114.         CASE 2                    ! special info
  115.              CALL read_doc1
  116.              LET preferred = 3
  117.         CASE 3                    ! file info
  118.              CALL read_doc2
  119.              LET preferred = 1
  120.         CASE 4,999                ! Configure the computer
  121.              LET progname$ = "RADDECAY"     ! used for .DAT file
  122.              LET path1$ = recpath$
  123.              LET path2$,path3$ = ""
  124.              ! pathpurpose format is: "Path for "&pathpurpose$(i)&" files: "
  125.              LET pathpurpose$(1) = "library record"
  126.              CALL Change_setup(progname$,path1$,path2$,path3$,pathpurpose$())
  127.              LET video$ = "MONO"  ! don't allow anything else
  128.              LET recpath$ = path1$
  129.              LET preferred = 1
  130.              LET first_time = true
  131.         CASE 5                    ! Quit this session
  132.              EXIT DO
  133.         END SELECT
  134.    USE                            ! For handling execution errors
  135.         IF Extype = 100 then      ! Escape key pressed to request main menu
  136.            LET preferred = 1      ! next menu preferred
  137.         ELSEIF extype = 105  then      ! expected, handle at higher level
  138.            LET preferred = 4
  139.         ELSE
  140.            CALL fatal(extype,extext$,"return")   ! unexpected error, don't do exit handler
  141.            LET preferred = 1      ! next menu preferred
  142.         END IF
  143.    END WHEN
  144. LOOP                              ! never exits, do stop stmt
  145.  
  146. CLEAR
  147. CALL plain_double_edge_box(8,20,59,14)
  148. SET CURSOR 10,1
  149. CALL highlight
  150. CALL print_centered(" RADDECAY SESSION TERMINATED ")
  151. CALL normal
  152. PRINT
  153. CALL print_centered("Session elapsed time: "&elapsed$(date,time,sessiondate,sessiontime))
  154. SET CURSOR 24,1
  155. SET CURSOR "on"
  156. END
  157.  
  158. SUB Welcome
  159.     DECLARE PUBLIC ver$,colour$(),recpath$
  160.     CALL normal
  161.     CALL plain_double_edge_box(4,21,58,8)
  162.     SET CURSOR 6,1
  163.     CALL highlight
  164.     CALL print_centered(" RADDECAY "&ver$&" ")
  165.     SET CURSOR 15,1
  166.     CALL print_centered( " A program for the public domain ")
  167.     CALL print_centered( "   by Grove Engineering, Inc.  ")
  168.     CALL normal
  169.     SET CURSOR 24,1
  170.     CALL print_centered("For the IBM PC with DOS 2.1 or equivalent.")
  171.     CALL print_centered("October/1987 - Grove Engineering,Inc.")
  172. END SUB
  173.  
  174. SUB Get_setup(defaults)
  175.     DIM msg$(5)
  176.     DECLARE PUBLIC colour$(),mspath$,matpath$,recpath$,video$
  177.     LET defaults = false
  178.     WHEN error in
  179.          OPEN  #1: NAME "RADDECAY.DAT", access input, organization text, create old
  180.          INPUT #1: colour$(1)
  181.          INPUT #1: colour$(2)
  182.          INPUT #1: colour$(3)
  183.          INPUT #1: colour$(4)
  184.          INPUT #1: recpath$       ! .REC files drive:directory
  185.          CLOSE #1
  186.     USE                           ! create new config file:
  187.          CLEAR                    ! for debugging, will show up on scroll back
  188.          IF extype <> 9003 then   ! if it wasn't "file doesn't exist" error
  189.             UNSAVE "RADDECAY.DAT"      ! somehow corrupted
  190.             EXIT HANDLER          ! can't deal with it
  191.          END IF
  192.          CALL set_defaults
  193.     END WHEN
  194.     CLEAR
  195.     CALL Welcome
  196.     PAUSE 2
  197.     ! check to see if record files are in directory
  198.     WHEN error in
  199.          OPEN #1: name recpath$ & "NUCLIDES.REC",access input,recsize 41
  200.          CLOSE #1
  201.          LET rec_check = 1
  202.     USE
  203.          CLOSE #1
  204.          IF extype = 9003 then
  205.             LET rec_check = 2
  206.          ELSE
  207.             CALL fatal(0,"","return")
  208.             LET rec_check = 3
  209.          END IF
  210.     END WHEN
  211.     SELECT CASE rec_check
  212.     CASE 1
  213.          ! all ok
  214.     CASE 2
  215.          LET msg$(1) = "  Did not find file NUCLIDES.REC !  "
  216.          LET msg$(2) = "in path "&recpath$
  217.          LET msg$(3) = " "
  218.          LET msg$(4) = "Please configure your *.REC file path"
  219.          LET msg$(5) = "specification from the main menu.    "
  220.          CALL bleep
  221.          CALL info_window(msg$,0)
  222.     CASE 3                        ! problem with read
  223.          CALL set_defaults
  224.     END SELECT
  225.  
  226.     SUB set_defaults
  227.         CALL default_colors(colour$)   ! set 'em
  228.         CALL askdir(path$)        ! get current drive 'n path
  229.         LET drive$ = path$[1:2]   ! save drive designator
  230.         LET recpath$ = path$&"\"  ! default
  231.         OPEN  #1: name "RADDECAY.DAT",access output,create newold,organization text
  232.         ERASE #1
  233.         PRINT #1: colour$(1)
  234.         PRINT #1: colour$(2)
  235.         PRINT #1: colour$(3)
  236.         PRINT #1: colour$(4)
  237.         PRINT #1: recpath$
  238.         CLOSE #1
  239.         LET defaults = true       ! tell caller that defaults were set
  240.     END SUB
  241. END SUB
  242.  
  243. SUB demopic
  244.     ! subroutine for generic library
  245.     ! draw picture
  246.     SET CURSOR 12,1
  247.     PRINT "This feature not needed for RADDECAY"
  248.     PRINT "Please ignore any messages"
  249.     PRINT "Press [Enter] or [Esc]"
  250. END SUB
  251.